Attribute VB_Name = "MSystemCode"
''' VBA Code Documentor 5.0 by Rob Bovey, copyright 1996-2004,
''' all rights reserved. May be redistributed for free,
''' but may not be sold without the author's explicit permission.
Option Explicit
Option Private Module

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Comments:   Creates the new workbook into which the project report will go.
'''
''' Arguments:  wkbReport   [out] An object reference to the new report workbook.
'''             wksDetail   [out] An object reference to the detail worksheet in
'''                         the wkbReport workbook.
'''             wksSummary  [out] An object reference to the summary worksheet
'''                         in the wkbReport workbook.
'''
''' Returns:    Boolean     True on success, False on error.
'''
''' Date        Developer           Action
''' --------------------------------------------------------------------------
''' 01/10/00    Rob Bovey           Created
''' 06/09/04    Rob Bovey           Updated coding conventions.
'''
Public Function bCreateReportWorkbook(ByRef wkbReport As Excel.Workbook, ByRef wksDetail As Excel.Worksheet, ByRef wksSummary As Excel.Worksheet) As Boolean

    If gbDEBUG_MODE Then
        On Error GoTo 0
    Else
        On Error GoTo ErrorHandler
    End If
    
    ''' Create a new single worksheet workbook.
    ''' The single worksheet will be the detail worksheet.
    Set wkbReport = Application.Workbooks.Add(xlWorksheet)
    Set wksDetail = wkbReport.Worksheets(1)
    wksDetail.Name = gszSHEET_DETAIL
    ''' Set the outlining correctly for the detail worksheet.
    wksDetail.Outline.SummaryRow = xlAbove
    
    ''' Copy the summary worksheet from this workbook to the report workbook.
    wksSummaryTemplate.Copy wksDetail
    Set wksSummary = wkbReport.Worksheets(gszSHEET_SUMMARY)
    
    bCreateReportWorkbook = True
    Exit Function

ErrorHandler:
    If Len(gszErrMsg) = 0 Then gszErrMsg = Err.Description
    If Err.Number <> glHANDLED_ERROR Then gszErrMsg = gszErrMsg & " (bCreateReportWorkbook)"
    bCreateReportWorkbook = False
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Comments:   Sorts the VBComponent summary table by VBComponent type.
'''
''' Arguments:  rngStartSort    [in] The top left cell in the VBComponent
'''                             summary table.
'''
''' Date        Developer           Action
''' --------------------------------------------------------------------------
''' 01/10/00    Rob Bovey           Created
''' 06/09/04    Rob Bovey           Updated coding conventions.
'''
Public Sub SortComponentSummary(ByRef rngStartSort As Excel.Range)

    Dim rngSortRange As Excel.Range
    Dim rngKey As Excel.Range
    
    Set rngKey = rngStartSort.Offset(0, 1)
    Set rngSortRange = rngStartSort.Parent.Range(rngStartSort, rngStartSort.End(xlDown).End(xlToRight))
    
    rngSortRange.Sort Key1:=rngKey, Order1:=xlAscending, Key2:=rngStartSort, Order2:=xlAscending, Header:=xlYes
    
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Comments:   Saves the project summary report workbook.
'''
''' Arguments:  wkbTarget           [in] The workbook being documented.
'''             wkbReportBook       [in] The report workbook.
'''
''' Returns:    Boolean             True on success, False on error.
'''
''' Date        Developer           Action
''' --------------------------------------------------------------------------
''' 01/10/00    Rob Bovey           Created
''' 06/09/04    Rob Bovey           Updated coding conventions.
'''
Public Function bSaveReportWorkbook(ByRef wkbTarget As Excel.Workbook, ByRef wkbReportBook As Excel.Workbook) As Boolean
    
    Dim szReportName As String
    Dim szPath As String
    Dim szTest As String
    
    If gbDEBUG_MODE Then
        On Error GoTo 0
    Else
        On Error GoTo ErrorHandler
    End If
    
    ''' Determine the path where the report workbook will be saved.
    If Len(wkbTarget.Path) = 0 Then
        If Len(Application.DefaultFilePath) = 0 Then
            szPath = "C:\"
        Else
            szPath = Application.DefaultFilePath
        End If
    Else
        szPath = wkbTarget.Path
    End If
    
    If Right$(szPath, 1) <> gszSEP Then szPath = szPath & gszSEP
    szReportName = gszFILE_REPORT_PREFIX & wkbTarget.Name
    
    ''' Check to see if a report file is already open.
    On Error Resume Next
        szTest = vbNullString
        szTest = Application.Workbooks(szReportName).Name
    If gbDEBUG_MODE Then
        On Error GoTo 0
    Else
        On Error GoTo ErrorHandler
    End If
    
    If Len(szTest) > 0 Then  ''' There is a report file already open.
    
        Application.ScreenUpdating = True
        
        MsgBox gszMSG_FILE_ALREADY_OPEN, vbExclamation, gszAPP_TITLE
        
        If Not Application.Dialogs(xlDialogSaveAs).Show Then    ''' Show the SaveAs dialog.
            ''' User didn't save the file.
            MsgBox gszERR_FILE_NOT_SAVED, vbExclamation, gszAPP_TITLE
        End If
        
    ''' Check to see if report file already exists.
    ElseIf Len(Dir$(szPath & szReportName)) > 0 Then
        
        Application.ScreenUpdating = True
        
        If MsgBox(gszMSG_FILE_OVERWRITE, vbExclamation + vbYesNo, gszAPP_TITLE) = vbYes Then
            wkbReportBook.SaveAs szPath & szReportName
        Else
            MsgBox gszERR_FILE_NOT_SAVED, vbExclamation, gszAPP_TITLE
        End If
        
    Else
        wkbReportBook.SaveAs szPath & szReportName
    End If
    
    bSaveReportWorkbook = True
    Exit Function

ErrorHandler:
    If Len(gszErrMsg) = 0 Then gszErrMsg = Err.Description
    If Err.Number <> glHANDLED_ERROR Then gszErrMsg = gszErrMsg & " (bSaveReportWorkbook)"
    bSaveReportWorkbook = False
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Comments:   Determines the text file size of the code module of
'''             the specified VBComponent.
'''
''' Arguments:  cmpComponent        The VBComponent to determine the
'''                                 text file size for.
'''
''' Returns:    Double              The text file size in kilobytes.
'''
''' Date        Developer           Action
''' --------------------------------------------------------------------------
''' 01/10/00    Rob Bovey           Created
''' 06/09/04    Rob Bovey           Modifed to return files size as a Double.
'''
Public Function dGetTextFileSize(ByVal cmpComponent As VBIDE.VBComponent) As Double

    ''' Even empty modules will return a non-zero file size. This is the
    ''' largest size in bytes that will be considered empty.
    Const lMAX_EMPTY_SIZE_MOD As Long = 31      ''' Standard modules
    Const lMAX_EMPTY_SIZE_CLASS As Long = 235   ''' Class modules (larger due to class property headers)
    
    Dim lFileSize As Long
    Dim lMaxEmptySize As Long
    Dim szExt As String
    Dim szFileName As String
    
    ''' Concatenate the correct filename for export.
    Select Case cmpComponent.Type
        Case vbext_ct_ClassModule, vbext_ct_Document
            szExt = ".cls"
            lMaxEmptySize = lMAX_EMPTY_SIZE_CLASS
        Case vbext_ct_MSForm
            szExt = ".frm"
            lMaxEmptySize = lMAX_EMPTY_SIZE_CLASS
        Case vbext_ct_StdModule
            szExt = ".bas"
            lMaxEmptySize = lMAX_EMPTY_SIZE_MOD
    End Select
    szFileName = cmpComponent.Name & szExt
    
    cmpComponent.Export gszTempPath & szFileName
    lFileSize = FileLen(gszTempPath & szFileName)
    
    On Error Resume Next
        Kill gszTempPath & szFileName
        Kill gszTempPath & "*.frx"
    On Error GoTo 0
    
    If lFileSize <= lMaxEmptySize Then
        ''' Empty code module.
        dGetTextFileSize = 0#
    Else
        dGetTextFileSize = lFileSize / 1024
    End If
    
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Comments:   Strips end-of-line comments from the specified code line.
'''
''' Arguments:  szLine      [in] The line to be stripped.
'''
''' Returns:    String      The stripped code line.
'''
''' Date        Developer           Action
''' --------------------------------------------------------------------------
''' 08/09/99    Stephen Bullen      Created
'''
Public Function szStripEndOfLineComments(ByRef szLine As String) As String

    Dim lLook As Long   ''' Where we're looking from in the string
    Dim lDQ As Long     ''' The position of the next double quote
    Dim lSQ As Long     ''' The position of the next single quote
    
    lLook = 1
    
    Do
    
        lSQ = InStr(lLook, szLine, gszSQ)
        If lSQ = 0 Then Exit Do
        
        lDQ = InStr(lLook, szLine, gszDQ)
        
        If lDQ = 0 Or lSQ < lDQ Then
            ''' Comment comes first, so return up to the comment
            szLine = Trim$(Left$(szLine, lSQ - 1))
            Exit Do
        End If
        
        ''' Found the start of a string, so find its end and look again
        lLook = InStr(lDQ + 1, szLine, gszDQ) + 1
    
    Loop Until lLook = 1

    szStripEndOfLineComments = szLine
    
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Comments:   Reassembles lines with line continuation characters.
'''             Increments the lLineCount variable to the end of the
'''             continued section.
'''
''' Arguments:  szLine      [in] The first section of the line to reassemble.
'''             lLineCount  [in] The code line number where szLine is located.
'''             modModule   [in] The code module where szLine is located.
'''
''' Returns:    String      The reassembled line.
'''
''' Date        Developer           Action
''' --------------------------------------------------------------------------
''' 01/10/00    Rob Bovey           Created
'''
Public Function szReassembleLine(ByRef szLine As String, ByRef lLineCount As Long, ByRef modModule As VBIDE.CodeModule) As String

    Dim szNextLine As String
    Dim szOutputLine As String
    
    szOutputLine = Left$(szLine, Len(szLine) - 1)

    Do
        
        ''' Increment to the next code line and grab it for processing.
        lLineCount = lLineCount + 1
        szNextLine = Trim$(modModule.Lines(lLineCount, 1))
        
        ''' Process the line and add it to the accumulator.
        If StrComp(Right$(szNextLine, 2), gszCONTINUED) = 0 Then
            szOutputLine = szOutputLine & Left$(szNextLine, Len(szNextLine) - 1)
        Else
            ''' The last line won't have a line continuation character.
            szOutputLine = szOutputLine & szNextLine
        End If
        
    Loop Until StrComp(Right$(szNextLine, Len(gszCONTINUED)), gszCONTINUED) <> 0
    
    ''' Return the reassembled code line.
    szReassembleLine = szStripEndOfLineComments(szOutputLine)
    
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Comments:   Returns the procedure name associated with the specified code
'''             line in the specified code module.
'''
''' Arguments:  lCodeLine   [in] The code module line number where szLine
'''                         is located.
'''             modModule   [in] The code module where szLine is located.
'''
''' Returns:    String      The procedure name if one exists, or gszEMPTY_STRING
'''                         if lCodeLine is in the Declarations section of the
'''                         CodeModule.
'''
''' Date        Developer           Action
''' --------------------------------------------------------------------------
''' 01/10/00    Rob Bovey           Created
''' 06/09/04    Rob Bovey           Updated coding conventions.
'''
Public Function szGetProcName(ByVal lCodeLine As Long, ByRef modModule As VBIDE.CodeModule) As String

    Dim szProcName As String
    
    ''' First look for Sub or Function procedures.
    szProcName = modModule.ProcOfLine(lCodeLine, vbext_pk_Proc)
    
    ''' If no sub or function procedure was located, check for property procedures.
    If Len(szProcName) = 0 Then szProcName = modModule.ProcOfLine(lCodeLine, vbext_pk_Get)
    If Len(szProcName) = 0 Then szProcName = modModule.ProcOfLine(lCodeLine, vbext_pk_Let)
    If Len(szProcName) = 0 Then szProcName = modModule.ProcOfLine(lCodeLine, vbext_pk_Set)
    
    ''' Return the result.
    szGetProcName = szProcName
    
End Function

